home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / nonfpu / ops.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-11-22  |  11.0 KB  |  332 lines
  1. Syntax24b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax10.Scn.Fnt
  5. (* Amiga NonFPU *) 
  6. MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *)
  7.  IMPORT OPM, AmigaMathL;
  8.  CONST
  9.   MaxStrLen* = 256;
  10.   MaxIdLen = 24;
  11.  TYPE
  12.   Name* = ARRAY MaxIdLen OF CHAR;
  13.   String* = ARRAY MaxStrLen OF CHAR;
  14.  (* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
  15.   name*: Name;
  16.   str*: String;
  17.   numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
  18.   intval*: LONGINT; (* integer value or string length *)
  19.   realval*: REAL;
  20.   lrlval*: LONGREAL;
  21.  (*symbols:
  22.      |  0          1          2          3          4
  23.   ---|--------------------------------------------------------
  24.    0 |  null       *          /          DIV        MOD
  25.    5 |  &          +          -          OR         =
  26.   10 |  #          <          <=         >          >=
  27.   15 |  IN         IS         ^          .          ,
  28.   20 |  :          ..         )          ]          }
  29.   25 |  OF         THEN       DO         TO         BY
  30.   30 |  (          [          {          ~          :=
  31.   35 |  number     NIL        string     ident      ;
  32.   40 |  |          END        ELSE       ELSIF      UNTIL
  33.   45 |  IF         CASE       WHILE      REPEAT     FOR
  34.   50 |  LOOP       WITH       EXIT       RETURN     ARRAY
  35.   55 |  RECORD     POINTER    BEGIN      CONST      TYPE
  36.   60 |  VAR        PROCEDURE  IMPORT     MODULE     eof    *)
  37.  CONST
  38.   (* numtyp values *)
  39.   char = 1; integer = 2; real = 3; longreal = 4;
  40.   (*symbol values*)
  41.   null = 0; times = 1; slash = 2; div = 3; mod = 4;
  42.   and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  43.   neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  44.   in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  45.   colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  46.   of = 25; then = 26; do = 27; to = 28; by = 29;
  47.   lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  48.   number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  49.   bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  50.   if = 45; case = 46; while = 47; repeat = 48; for = 49;
  51.   loop = 50; with = 51; exit = 52; return = 53; array = 54;
  52.   record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  53.   var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  54.   ch: CHAR;     (*current character*)
  55.  PROCEDURE err(n: INTEGER);
  56.  BEGIN OPM.err(n)
  57.  END err;
  58.  PROCEDURE Str(VAR sym: SHORTINT);
  59.   VAR i: INTEGER; och: CHAR;
  60.  BEGIN i := 0; och := ch;
  61.   LOOP OPM.Get(ch);
  62.    IF ch = och THEN EXIT END ;
  63.    IF ch < " " THEN err(3); EXIT END ;
  64.    IF i = MaxStrLen-1 THEN err(241); EXIT END ;
  65.    str[i] := ch; INC(i)
  66.   END ;
  67.   OPM.Get(ch); str[i] := 0X; intval := i + 1;
  68.   IF intval = 2 THEN
  69.    sym := number; numtyp := 1; intval := ORD(str[0])
  70.   ELSE sym := string
  71.   END
  72.  END Str;
  73.  PROCEDURE Identifier(VAR sym: SHORTINT);
  74.   VAR i: INTEGER;
  75.  BEGIN i := 0;
  76.   REPEAT
  77.    name[i] := ch; INC(i); OPM.Get(ch)
  78.   UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
  79.   IF i = MaxIdLen THEN err(240); DEC(i) END ;
  80.   name[i] := 0X; sym := ident
  81.  END Identifier;
  82.  PROCEDURE Number;
  83.   VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f, Dummy: LONGREAL; expCh: CHAR; neg: BOOLEAN;
  84.   PROCEDURE Ten(e: INTEGER; VAR Erg: LONGREAL);
  85. (*  PROCEDURE Ten(e: INTEGER): LONGREAL;*)
  86.    VAR x, p: LONGREAL;
  87.   BEGIN x := 1; p := 10;
  88.    WHILE e > 0 DO
  89. (*    IF ODD(e) THEN x := x*p END;*)
  90.     IF ODD(e) THEN AmigaMathL.Mul(x,p,x);END;
  91.    e := e DIV 2;
  92. (*    IF e > 0 THEN p := p*p END (* prevent overflow *)*)
  93.     IF e > 0 THEN AmigaMathL.Mul(p,p,p);END (* prevent overflow *)
  94.    END;
  95. (*   RETURN x*)
  96.    Erg:=x;
  97.   END Ten;
  98.   PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
  99.   BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
  100.    IF ch <= "9" THEN RETURN ORD(ch) - ORD("0")
  101.    ELSIF hex THEN RETURN ORD(ch) - ORD("A") + 10
  102.    ELSE err(2); RETURN 0
  103.    END
  104.   END Ord;
  105.  BEGIN (* ("0" <= ch) & (ch <= "9") *)
  106.   i := 0; m := 0; n := 0; d := 0;
  107.   LOOP (* read mantissa *)
  108.    IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
  109.     IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
  110.      IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
  111.      INC(m)
  112.     END;
  113.     OPM.Get(ch); INC(i)
  114.    ELSIF ch = "." THEN OPM.Get(ch);
  115.     IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
  116.     ELSIF d = 0 THEN (* i > 0 *) d := i
  117.     ELSE err(2)
  118.     END
  119.    ELSE EXIT
  120.    END
  121.   END; (* 0 <= n <= m <= i, 0 <= d <= i *)
  122.   IF d = 0 THEN (* integer *)
  123.    IF n = m THEN intval := 0; i := 0;
  124.     IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char;
  125.      IF n <= 2 THEN
  126.       WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
  127.      ELSE err(203)
  128.      END
  129.     ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
  130.      IF n <= OPM.MaxHDig THEN
  131.       IF (n = OPM.MaxHDig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
  132.       WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
  133.      ELSE err(203)
  134.      END
  135.     ELSE (* decimal *) numtyp := integer;
  136.      WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
  137.       IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
  138.       ELSE err(203)
  139.       END
  140.      END
  141.     END
  142.    ELSE err(203)
  143.    END
  144.   ELSE (* fraction *)
  145.    f := 0; e := 0; expCh := "E";
  146.    WHILE n > 0 DO (* 0 <= f < 1 *) 
  147.        DEC(n);
  148.        AmigaMathL.IntToReal(Ord(dig[n], FALSE), Dummy);
  149.        AmigaMathL.Add(Dummy,f,f);
  150.        AmigaMathL.IntToReal(10,Dummy);
  151.        AmigaMathL.Div(f,Dummy,f);
  152.        (* f := (Ord(dig[n], FALSE) + f)/10 *)
  153.    END;
  154.    IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
  155.     IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
  156.     ELSIF ch = "+" THEN OPM.Get(ch)
  157.     END;
  158.     IF ("0" <= ch) & (ch <= "9") THEN
  159.      REPEAT n := Ord(ch, FALSE); OPM.Get(ch);
  160.       IF e <= (MAX(INTEGER) - n) DIV 10 THEN e := e*10 + n
  161.       ELSE err(203)
  162.       END
  163.      UNTIL (ch < "0") OR ("9" < ch);
  164.      IF neg THEN e := -e END
  165.     ELSE err(2)
  166.     END
  167.    END;
  168.    DEC(e, i-d-m); (* decimal point shift *)
  169.    IF expCh = "E" THEN numtyp := real;
  170.     IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
  171.      IF e < 0 THEN
  172.          Ten(-e, Dummy);
  173.          AmigaMathL.Div(f,Dummy,Dummy);
  174.          AmigaMathL.Short(Dummy,realval);
  175.      ELSE
  176.          Ten(e, Dummy);
  177.          AmigaMathL.Mul(f,Dummy,Dummy);
  178.          AmigaMathL.Short(Dummy,realval);
  179.      END
  180.     ELSE err(203)
  181.     END
  182.    ELSE numtyp := longreal;
  183.     IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
  184.      IF e < 0 THEN
  185.          Ten(-e, Dummy);
  186.          AmigaMathL.Div(f,Dummy,lrlval);
  187.      ELSE
  188.          Ten(e, Dummy);
  189.          AmigaMathL.Mul(f,Dummy,lrlval);
  190.      END
  191.     ELSE err(203)
  192.     END
  193. (*    IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
  194.      IF e < 0 THEN realval := SHORT(f / Ten(-e))
  195.      ELSE realval := SHORT(f * Ten(e))
  196.      END
  197.     ELSE err(203)
  198.     END
  199.    ELSE numtyp := longreal;
  200.     IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
  201.      IF e < 0 THEN lrlval := f / Ten(-e)
  202.      ELSE lrlval := f * Ten(e)
  203.      END
  204.     ELSE err(203)
  205.     END*)
  206.    END
  207.   END
  208.  END Number;
  209.  PROCEDURE Get*(VAR sym: SHORTINT);
  210.   VAR s: SHORTINT;
  211.   PROCEDURE Comment; (* do not read after end of file *)
  212.   BEGIN OPM.Get(ch);
  213.    LOOP
  214.     LOOP
  215.      WHILE ch = "(" DO OPM.Get(ch);
  216.       IF ch = "*" THEN Comment END
  217.      END ;
  218.      IF ch = "*" THEN OPM.Get(ch); EXIT END ;
  219.      IF ch = OPM.Eot THEN EXIT END ;
  220.      OPM.Get(ch)
  221.     END ;
  222.     IF ch = ")" THEN OPM.Get(ch); EXIT END ;
  223.     IF ch = OPM.Eot THEN err(5); EXIT END
  224.    END
  225.   END Comment;
  226.  BEGIN
  227.   OPM.errpos := OPM.curpos-1;
  228.   WHILE ch <= " " DO (*ignore control characters*)
  229.    IF ch = OPM.Eot THEN sym := eof; RETURN
  230.    ELSE OPM.Get(ch)
  231.    END
  232.   END ;
  233.   CASE ch OF   (* ch > " " *)
  234.    | 22X, 27X  : Str(s)
  235.    | "#"  : s := neq; OPM.Get(ch)
  236.    | "&"  : s :=  and; OPM.Get(ch)
  237.    | "("  : OPM.Get(ch);
  238.         IF ch = "*" THEN Comment; Get(s)
  239.          ELSE s := lparen
  240.         END
  241.    | ")"  : s := rparen; OPM.Get(ch)
  242.    | "*"  : s :=  times; OPM.Get(ch)
  243.    | "+"  : s :=  plus; OPM.Get(ch)
  244.    | ","  : s := comma; OPM.Get(ch)
  245.    | "-"  : s :=  minus; OPM.Get(ch)
  246.    | "."  : OPM.Get(ch);
  247.         IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END
  248.    | "/"  : s := slash;  OPM.Get(ch)
  249.    | "0".."9": Number; s := number
  250.    | ":"  : OPM.Get(ch);
  251.         IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END
  252.    | ";"  : s := semicolon; OPM.Get(ch)
  253.    | "<"  : OPM.Get(ch);
  254.         IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END
  255.    | "="  : s :=  eql; OPM.Get(ch)
  256.    | ">"  : OPM.Get(ch);
  257.         IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END
  258.    | "A": Identifier(s); IF name = "ARRAY" THEN s := array END
  259.    | "B": Identifier(s);
  260.       IF name = "BEGIN" THEN s := begin
  261.       ELSIF name = "BY" THEN s := by
  262.       END
  263.    | "C": Identifier(s);
  264.       IF name = "CASE" THEN s := case
  265.       ELSIF name = "CONST" THEN s := const
  266.       END
  267.    | "D": Identifier(s);
  268.       IF name = "DO" THEN s := do
  269.       ELSIF name = "DIV" THEN s := div
  270.       END
  271.    | "E": Identifier(s);
  272.       IF name = "END" THEN s := end
  273.       ELSIF name = "ELSE" THEN s := else
  274.       ELSIF name = "ELSIF" THEN s := elsif
  275.       ELSIF name = "EXIT" THEN s := exit
  276.       END
  277.    | "F": Identifier(s); IF name = "FOR" THEN s := for END
  278.    | "I": Identifier(s);
  279.       IF name = "IF" THEN s := if
  280.       ELSIF name = "IN" THEN s := in
  281.       ELSIF name = "IS" THEN s := is
  282.       ELSIF name = "IMPORT" THEN s := import
  283.       END
  284.    | "L": Identifier(s); IF name = "LOOP" THEN s := loop END
  285.    | "M": Identifier(s);
  286.       IF name = "MOD" THEN s := mod
  287.       ELSIF name = "MODULE" THEN s := module
  288.       END
  289.    | "N": Identifier(s); IF name = "NIL" THEN s := nil END
  290.    | "O": Identifier(s);
  291.       IF name = "OR" THEN s := or
  292.       ELSIF name = "OF" THEN s := of
  293.       END
  294.    | "P": Identifier(s);
  295.       IF name = "PROCEDURE" THEN s := procedure
  296.       ELSIF name = "POINTER" THEN s := pointer
  297.       END
  298.    | "R": Identifier(s);
  299.       IF name = "RECORD" THEN s := record
  300.       ELSIF name = "REPEAT" THEN s := repeat
  301.       ELSIF name = "RETURN" THEN s := return
  302.       END
  303.    | "T": Identifier(s);
  304.       IF name = "THEN" THEN s := then
  305.       ELSIF name = "TO" THEN s := to
  306.       ELSIF name = "TYPE" THEN s := type
  307.       END
  308.    | "U": Identifier(s); IF name = "UNTIL" THEN s := until END
  309.    | "V": Identifier(s); IF name = "VAR" THEN s := var END
  310.    | "W": Identifier(s);
  311.       IF name = "WHILE" THEN s := while
  312.       ELSIF name = "WITH" THEN s := with
  313.       END
  314.    | "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
  315.    | "["  : s := lbrak; OPM.Get(ch)
  316.    | "]"  : s := rbrak; OPM.Get(ch)
  317.    | "^"  : s := arrow; OPM.Get(ch)
  318.    | "a".."z": Identifier(s)
  319.    | "{"  : s := lbrace; OPM.Get(ch)
  320.    | "|"  : s := bar; OPM.Get(ch)
  321.    | "}"  : s := rbrace; OPM.Get(ch)
  322.    | "~"  : s := not; OPM.Get(ch)
  323.    | 7FX  : s := upto; OPM.Get(ch)
  324.   ELSE s :=  null; OPM.Get(ch)
  325.   END ;
  326.   sym := s
  327.  END Get;
  328.  PROCEDURE Init*;
  329.  BEGIN ch := " "
  330.  END Init;
  331. END OPS.
  332.